Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/toolkit/riruf1/empform.frm

Text File | 1995-05-19 | 16KB | 649 lines

VERSION 2.00
Begin Form EmpForm
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Employee Data"
   ClientHeight    =   4800
   ClientLeft      =   1860
   ClientTop       =   1515
   ClientWidth     =   5445
   Height          =   5205
   KeyPreview      =   -1  'True
   Left            =   1800
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4800
   ScaleWidth      =   5445
   Top             =   1170
   Width           =   5565
   Begin SSFrame Frame3D1
      Font3D          =   0  'None
      Height          =   2175
      Left            =   120
      TabIndex        =   13
      Top             =   2520
      Width           =   5175
      Begin ComboBox cboState
         Height          =   300
         Left            =   3000
         Style           =   2  'Dropdown List
         TabIndex        =   11
         Top             =   1680
         Width           =   855
      End
      Begin SSCheck chkActive
         Caption         =   "&Active"
         Font3D          =   0  'None
         Height          =   255
         Left            =   4080
         TabIndex        =   12
         Top             =   1680
         Width           =   855
      End
      Begin ComboBox cboWage
         Height          =   300
         Left            =   1800
         Sorted          =   -1  'True
         TabIndex        =   10
         Top             =   1680
         Width           =   1095
      End
      Begin ComboBox cboStatus
         Height          =   300
         Left            =   120
         Style           =   2  'Dropdown List
         TabIndex        =   8
         Top             =   960
         Width           =   1815
      End
      Begin MaskEdBox txtHireDate
         Height          =   285
         Left            =   120
         Mask            =   "##/##/####"
         MaxLength       =   10
         PromptChar      =   "_"
         TabIndex        =   9
         Top             =   1680
         Width           =   1335
      End
      Begin TextBox txtFirstName
         Height          =   285
         Left            =   120
         MaxLength       =   20
         TabIndex        =   6
         Top             =   360
         Width           =   2295
      End
      Begin TextBox txtLastName
         Height          =   285
         Left            =   2640
         MaxLength       =   20
         TabIndex        =   7
         Top             =   360
         Width           =   2295
      End
      Begin Label Label7
         BackColor       =   &H00C0C0C0&
         Caption         =   "State:"
         Height          =   255
         Left            =   3000
         TabIndex        =   21
         Top             =   1440
         Width           =   615
      End
      Begin Label Label6
         BackColor       =   &H00C0C0C0&
         Caption         =   "Wage:"
         Height          =   255
         Left            =   1800
         TabIndex        =   20
         Top             =   1440
         Width           =   615
      End
      Begin Label lblEmpNo
         BackColor       =   &H00C0C0C0&
         Height          =   255
         Left            =   2640
         TabIndex        =   19
         Top             =   960
         Width           =   735
      End
      Begin Label Label5
         BackColor       =   &H00C0C0C0&
         Caption         =   "Status:"
         Height          =   255
         Left            =   120
         TabIndex        =   18
         Top             =   720
         Width           =   615
      End
      Begin Label Label4
         BackColor       =   &H00C0C0C0&
         Caption         =   "Hire Date:"
         Height          =   255
         Left            =   120
         TabIndex        =   17
         Top             =   1440
         Width           =   975
      End
      Begin Label Label3
         BackColor       =   &H00C0C0C0&
         Caption         =   "First Name:"
         Height          =   255
         Left            =   120
         TabIndex        =   16
         Top             =   120
         Width           =   1095
      End
      Begin Label Label2
         BackColor       =   &H00C0C0C0&
         Caption         =   "Last Name:"
         Height          =   255
         Left            =   2640
         TabIndex        =   15
         Top             =   120
         Width           =   1095
      End
      Begin Label Label1
         BackColor       =   &H00C0C0C0&
         Caption         =   "Employee Number:"
         Height          =   255
         Left            =   2640
         TabIndex        =   14
         Top             =   720
         Width           =   1695
      End
   End
   Begin CommandButton cmdDelete
      Caption         =   "&Delete"
      Height          =   375
      Left            =   3840
      TabIndex        =   4
      Top             =   1560
      Width           =   1215
   End
   Begin CommandButton cmdUpdate
      Caption         =   "&Update"
      Enabled         =   0   'False
      Height          =   375
      Left            =   3840
      TabIndex        =   3
      Top             =   1080
      Width           =   1215
   End
   Begin CommandButton cmdNew
      Caption         =   "&New"
      Height          =   375
      Left            =   3840
      TabIndex        =   2
      Top             =   600
      Width           =   1215
   End
   Begin CommandButton cmdEdit
      Caption         =   "&Edit"
      Default         =   -1  'True
      Height          =   375
      Left            =   3840
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin ListBox lstEmps
      Height          =   2370
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3255
   End
   Begin CommandButton cmdClose
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   375
      Left            =   3840
      TabIndex        =   5
      Top             =   2040
      Width           =   1215
   End
End
Option Explicit
Dim dsData As dynaset
Dim bNew%, bChange%, bLocked%
Dim lEmpNo&
Dim bOpen%

Sub cboState_Change ()
    bChange = True
End Sub

Sub cboStatus_Change ()
    bChange = True
End Sub

Sub cboWage_Change ()
    bChange = True
End Sub

Sub cboWage_LostFocus ()
    CheckAndSaveCbo cboWage, "Wages", "Wage", True
End Sub

Function CheckChange () As Integer
    Dim nResponse%
    If bChange = True Then
    Beep
    nResponse = MsgBox("Discard current changes ?", MB_YESNO + MB_ICONQUESTION, TheAppTitle)
    If nResponse = IDYES Then
        CheckChange = True
    Else
        CheckChange = False
    End If
    Else
    CheckChange = True
    End If

End Function

Sub chkActive_Click (Value As Integer)
    bChange = True
End Sub

Sub cmdClose_Click ()
    If CheckChange() Then
    Unload EmpForm
    End If
End Sub

Sub cmdDelete_Click ()
    On Error GoTo delErr
    Dim ssData As snapshot
    Dim qd As querydef

    lEmpNo = GetLBID(lstEmps, "Employee")
    If lEmpNo = -1 Then
    Exit Sub
    End If

    If Not AskUser("Are you sure you want to delete the selected record?") Then
    ArrowCursor
    Exit Sub
    End If

    If bLocked Then
    dsData.Update
    bLocked = False
    End If

    Set qd = TheDatabase.OpenQueryDef("DeleteEmployee")
    qd!id = lEmpNo        ' Set parameter.
    qd.Execute

    txtLastName.Text = ""
    txtFirstName.Text = ""
    SelectText txtHireDate
    txtHireDate.SelText = ""
    chkActive.Value = False

    'reset combos
    cboStatus.ListIndex = -1
    cboWage.ListIndex = -1
    cboWage.Text = ""
    cboState.ListIndex = -1

    LoadListBox "GetAllEmps", -1, lstEmps, False, ","

    bNew = False
    cmdNew.Caption = "&New"
    cmdUpdate.Caption = "&Update"
    cmdUpdate.Enabled = False
    DoEvents
    bChange = False
    ArrowCursor
    Exit Sub

delErr:
    ArrowCursor
    GetErrorMsg Err
    Exit Sub

End Sub

Sub cmdEdit_Click ()
    On Error GoTo editErr
    Dim qd As querydef
    Dim sBuff$, sTmp$, sLine$, sKey$, stat$, lTmp&

    'check for list box selection
    lEmpNo = GetLBID(lstEmps, "Employee")
    If lEmpNo = -1 Then
    Exit Sub
    End If

    HourglassCursor
    bNew = False

    'check for currently loaded record
    If CheckChange() Then

    Enable True

    Set qd = TheDatabase.OpenQueryDef("GetAllEmpData")
    Set dsData = qd.CreateDynaset()
    bOpen = True
    qd.Close

    sBuff = "EmpNo = " & Str$(lEmpNo)
    dsData.FindFirst sBuff

    If dsData.NoMatch Then
        InformUser "ID no longer available: "
    Else
        dsData.Edit
        bLocked = True

        lblEmpNo.Caption = lEmpNo
        txtLastName.Text = ReturnString("LastName")
        txtFirstName.Text = ReturnString("FirstName")
        SelectText txtHireDate
        txtHireDate.SelText = Format$(ReturnString("HireDate"), "mm/dd/yyyy")

        If Not IsNull(dsData("Status")) Then
        ScanCombo dsData("Status"), cboStatus
        Else
        cboStatus.ListIndex = -1
        End If

        cboWage.Text = Format$(ReturnString("Wage"), "##.00")
        FindState ReturnString("State"), cboState

        If Not IsNull(dsData("Active")) Then
        chkActive.Value = Val(dsData("Active"))
        Else
        chkActive.Value = False
        End If

        SelectText txtLastName
        SelectText txtFirstName
        SelectText txtHireDate

        cmdUpdate.Caption = "&Update"
        cmdUpdate.Enabled = True
        DoEvents
        bChange = False
        bNew = False
        txtFirstName.SetFocus
    End If
    End If
    ArrowCursor
    Exit Sub

editErr:
    ArrowCursor
    GetErrorMsg Err
    Exit Sub

End Sub

Sub cmdNew_Click ()

    'blank fields
    txtLastName.Text = ""
    txtFirstName.Text = ""
    lblEmpNo.Caption = ""

    'reset combos
    cboStatus.ListIndex = -1
    cboWage.ListIndex = -1
    cboWage.Text = ""
    cboState.ListIndex = -1

    If Not bNew Then
    lEmpNo = GetID("Employee")
    lblEmpNo.Caption = Str$(lEmpNo)
    SelectText txtHireDate
    txtHireDate.SelText = Format$(Now, "mm/dd/yyyy")
    chkActive.Value = True
    Enable True
    bNew = True
    cmdNew.Caption = "&Cancel"
    cmdUpdate.Caption = "&Save"
    cmdUpdate.Enabled = True
    txtFirstName.SetFocus
    Else
    Enable False
    bNew = False
    SelectText txtHireDate
    txtHireDate.SelText = ""
    chkActive.Value = False
    cmdNew.Caption = "&New"
    cmdUpdate.Caption = "&Update"
    cmdUpdate.Enabled = False
    End If
    DoEvents
    bChange = False

End Sub

Sub cmdUpdate_Click ()
    On Error GoTo UpdateErr
    Dim qd As querydef
    Dim sTmp$

    If Len(LTrim$(txtLastName.Text)) < 1 Then
    StopUser "Last name cannot be blank!"
    Exit Sub
    End If

    If Len(LTrim$(txtFirstName.Text)) < 1 Then
    StopUser "First name cannot be blank!"
    Exit Sub
    End If

    HourglassCursor
    If bNew Then

    Set qd = TheDatabase.OpenQueryDef("GetAllEmpData")
    Set dsData = qd.CreateDynaset()
    bOpen = True
    qd.Close

    If dsData.EOF And dsData.BOF Then
        dsData.AddNew
        dsData("EmpNo") = lEmpNo
        dsData.Update
        dsData.MoveFirst
    Else
        dsData.AddNew
        dsData("EmpNo") = lEmpNo
        dsData.Update
        dsData.MoveLast
    End If

    dsData.Edit
    End If

    dsData("LastName") = txtLastName.Text
    dsData("FirstName") = txtFirstName.Text
    dsData("HireDate") = txtHireDate.Text

    If cboStatus.ListIndex = -1 Then
    dsData("Status") = -1
    Else
    dsData("Status") = cboStatus.ItemData(cboStatus.ListIndex)
    End If

    dsData("Active") = LTrim$(Str$(Abs(chkActive.Value)))

    dsData("Wage") = Val(cboWage.Text)
    dsData("State") = LTrim$(cboState.Text)

    dsData.Update
    bNew = False
    cmdNew.Caption = "&New"
    bLocked = False
    Enable False
    cmdUpdate.Enabled = False
    cmdUpdate.Caption = "&Update"
    DoEvents
    bChange = False

    LoadListBox "GetAllEmps", lEmpNo, lstEmps, False, ","
    ArrowCursor
    Exit Sub

UpdateErr:
    ArrowCursor
    GetErrorMsg Err
    Exit Sub

End Sub

Sub Enable (bVal%)
    cboStatus.Enabled = bVal
    cboWage.Enabled = bVal
    cboState.Enabled = bVal
    txtLastName.Enabled = bVal
    txtFirstName.Enabled = bVal
    txtHireDate.Enabled = bVal
    chkActive.Enabled = bVal
End Sub

Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    If KeyCode = KEY_F1 Then
    CallHelp Employee_Data_Form
    End If
End Sub

Sub Form_Load ()
    Enable False
    bNew = False
    bOpen = False
    bChange = False
    bLocked = False
    LoadListBox "GetAllEmps", -1, lstEmps, False, ","
    LoadCombo "GetActiveStatuses", -1, cboStatus, False, "", True
    LoadCombo2 "GetWages", -1, cboWage, False, "", True, True
    FillStates cboState

End Sub

Sub Form_Unload (Cancel As Integer)
    If bOpen Then
    dsData.Close
    End If
End Sub

Sub LoadCombo2 (sQDef As String, lDefault As Long, cboCtrl As ComboBox, bParam As Integer, sSeparator As String, bClear As Integer, bPad%)
    On Error GoTo lc2Err
    Dim ssData As snapshot
    Dim qDef As querydef
    Dim sLine$, i%, nIndex%, sSep$, sTmp$

    HourglassCursor
    nIndex = -1

    Set qDef = TheDatabase.OpenQueryDef(sQDef)
    If bParam Then
    qDef!Param = lDefault
    End If

    Set ssData = qDef.CreateSnapshot()
    qDef.Close

    If Len(sSeparator) = 0 Then
    sSep = " "
    Else
    sSep = sSeparator & " "
    End If

    If bClear Then
    cboCtrl.Clear
    End If

    While Not ssData.EOF
    If Not IsNull(ssData(0)) Then

    sLine = ""
    For i = 0 To ssData.Fields.Count - 1
        If Not IsNull(ssData(i)) Then
        If bPad Then
            sLine = sLine & Format$(AddQuoteV(ssData(i)), "##.00")
        Else
            sLine = sLine & AddQuoteV(ssData(i))
        End If
        If i < ssData.Fields.Count - 1 Then
            sLine = sLine & sSep
        End If
        End If
    Next
    cboCtrl.AddItem sLine
    If lDefault <> -1 Then
        If lDefault = ssData(0) Then
        nIndex = cboCtrl.NewIndex
        End If
    End If

    End If
    ssData.MoveNext
    Wend
    ssData.Close

    If nIndex <> -1 Then
    cboCtrl.ListIndex = nIndex
    End If
    ArrowCursor
    Exit Sub

lc2Err:
    ArrowCursor
    GetErrorMsg Err
    Exit Sub

End Sub

Sub lstEmps_DblClick ()
    cmdEdit = True
End Sub

Function ReturnString$ (sField$)
    If Not IsNull(dsData(sField)) Then
    ReturnString = dsData(sField)
    Else
    ReturnString = ""
    End If
End Function

Sub txtFirstName_Change ()
    bChange = True
End Sub

Sub txtFirstName_LostFocus ()
    SelectText txtFirstName
End Sub

Sub txtHireDate_Change ()
    bChange = True
    If InStr(txtHireDate.Text, "_") = 0 Then
    If ValidateDate(txtHireDate) Then
        cmdUpdate.Enabled = True
    Else
        cmdUpdate.Enabled = False
    End If
    Else
    cmdUpdate.Enabled = False
    End If
End Sub

Sub txtHireDate_LostFocus ()
    SelectText txtHireDate
End Sub

Sub txtLastName_Change ()
    bChange = True
End Sub

Sub txtLastName_LostFocus ()
    SelectText txtLastName
End Sub